home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / EV61.ARJ / B2E.BAS next >
BASIC Source File  |  1995-08-05  |  5KB  |  166 lines
  1. ' B2E, BMP to EGT Converter
  2. ' by Beowulf Shaeffer 1995
  3. '
  4. ' At some places you'll find some dutch words... Enjoy :-)
  5. '
  6. ' Dim some stuff...
  7. DIM bmpname AS STRING, buffer AS STRING, colors AS STRING, nieuw AS STRING
  8.  
  9. ' Standard stuff, in ANY program
  10. RANDOMIZE TIMER: ON ERROR GOTO foutje
  11.  
  12. letop:
  13. ' Check if there is a dot at the commandline
  14. plaats = INSTR(COMMAND$, ".")   
  15.  
  16. ' Dot present?
  17. IF plaats > 0 THEN              
  18.         ' Yes? Cut name just before
  19.         bmpname = LEFT$(COMMAND$, plaats - 1)   
  20. ELSE
  21.         ' No? Don't change
  22.         bmpname = COMMAND$      
  23. END IF
  24.  
  25. ' Remove trailing and leading spaces
  26. bmpname = RTRIM$(LTRIM$(bmpname))       
  27.  
  28. vgacheck:
  29. ' Point to the BIOS data segment 0040:0000
  30. DEF SEG = &H40                  
  31. ' Check bit 0 at 0040:0089
  32. vga = 0 - (PEEK(&H89) AND 1)    
  33. ' Restore segment to BASIC's-
  34. DEF SEG                         
  35.  
  36. ' Check for message
  37. IF NOT vga THEN PRINT "No VGA present. Can't continue...": GOTO klaar 
  38.  
  39. okee:
  40. ' Prepare 1024 bytes in string "colors"
  41. colors = STRING$(1024, 0)       
  42. ' I don't remember why I put this here...
  43. nieuw$=""       
  44.  
  45. ' Tell DOS that we like to read binary files, and everytime we read, we'd like
  46. ' 1024 bytes at a time.
  47. OPEN bmpname + ".bmp" FOR BINARY ACCESS READ AS #1 LEN = 1024
  48.  
  49. ' Check the size of the file
  50. grootte = LOF(1)
  51. ' Correct size?
  52. IF grootte <> 65078 THEN GOTO foutje  
  53.  
  54. ' Now load the palette in string "colors". The palette begins at byte 55 of
  55. ' the BMP file.
  56. GET #1, 55, colors: CLOSE 1    
  57.  
  58. ' Switch to mode 13h, MCGA
  59. SCREEN 13                      
  60. ' Prepare 320 bytes (linesize) in string "buffer"
  61. buffer = STRING$(320, 0)       
  62.  
  63. ' Tell DOS that we like to read binary files, and everytime we read, we'd like
  64. ' 320 bytes at a time.
  65. OPEN bmpname + ".bmp" FOR BINARY ACCESS READ AS #1 LEN = 320
  66.  
  67. ' Vertical position into y%
  68. y% = 200
  69. ' Load the first block of bytes into string "buffer"
  70. GET #1, 1078 + 1, buffer
  71. ' Process this horizontal line
  72. GOSUB rafel
  73. ' Now setup the last 199 horizontal lines to be processed
  74. FOR stuks% = 1 TO y%
  75. ' Get the next block of bytes into string "buffer"
  76. GET #1, , buffer
  77. ' Process this line also
  78. GOSUB rafel
  79. ' Do the next line
  80. NEXT stuks%
  81. ' No more need for loading
  82. CLOSE #1
  83.  
  84. ' The picture is on the screen now, BUT the colors are all messed up!
  85. ' The palette is processed last, because you can see the progress by looking
  86. ' at the screen...
  87.  
  88. ' The new palette is completely empty...
  89. nieuw = ""
  90. ' Prepare for colors #0 through #255
  91. FOR stuks% = 0 TO 255
  92.  
  93. ' Get RED component
  94. r = INT(ASC(MID$(colors, stuks% * 4 + 1, 1)) / 4)
  95. ' Get GREEN component
  96. g = INT(ASC(MID$(colors, stuks% * 4 + 2, 1)) / 4)
  97. ' Get BLUE component
  98. b = INT(ASC(MID$(colors, stuks% * 4 + 3, 1)) / 4)
  99.  
  100. ' The new order is now BGR! And every fourth palette value is thrown away
  101. nieuw = nieuw + CHR$(b) + CHR$(g) + CHR$(r)
  102.  
  103. ' Set this color to the correct one
  104. ' This is a very bulky way to do it, but it works
  105. PALETTE stuks%, VAL("&h" + RIGHT$("0" + HEX$(r), 2) + RIGHT$("0" + HEX$(g), 2) + RIGHT$("0" + HEX$(b), 2))
  106. ' Do the next color
  107. NEXT stuks%
  108.  
  109. ' Prepare to write the new file with blocks of 768 bytes (palette size)
  110. ' We only do this once...
  111. OPEN bmpname + ".egt" FOR BINARY ACCESS WRITE AS #1 LEN = 768
  112. ' Write the palette
  113. PUT #1, 1, nieuw
  114. ' Stop it
  115. CLOSE #1
  116.  
  117. ' Prepare to write the new file with blocks of 320 bytes (linesize)
  118. OPEN bmpname + ".egt" FOR BINARY ACCESS WRITE AS #1 LEN = 320
  119. ' Begin at the top horizontal line
  120. stuks% = 0
  121. ' Process that line
  122. GOSUB tsjakka
  123. ' Put it in the file just after the palette
  124. PUT #1, 769, buffer
  125. ' Prepare the next 199 lines
  126. FOR stuks% = 1 TO 199
  127. ' Process that line also
  128. GOSUB tsjakka
  129. ' Put the line just after the previous one
  130. PUT #1, , buffer
  131. ' Do the next line
  132. NEXT stuks%
  133.  
  134. klaar:
  135. ' Stop the process, and return to textmode
  136. CLOSE : SCREEN 0
  137. SYSTEM: END
  138.  
  139. ' Simple errorroutine
  140. foutje:
  141. PRINT "Sorry, it does not exist, or it's not of the required size!"
  142. GOTO klaar
  143.  
  144. rafel:
  145. ' Prepare 320 pixels horizontally
  146. FOR stuk% = 1 TO 320
  147. ' Put the correct pixel on the screen
  148. PSET (stuk% - 1, y%), ASC(MID$(buffer, stuk%, 1))
  149. ' Do the next one
  150. NEXT stuk%
  151. ' Decrease the vertical position
  152. y% = y% - 1
  153. RETURN
  154.  
  155. tsjakka:
  156. ' Clear the bufferstring
  157. buffer = ""
  158. ' Prepare 320 pixels horizontally
  159. FOR stuk% = 1 TO 320
  160. ' Get the pixel from the screen
  161. buffer = buffer + CHR$(POINT(stuk% - 1, stuks%))
  162. ' Do the next one
  163. NEXT stuk%
  164. RETURN
  165.  
  166.